<%
'######################################################################
'## ab.e.base64.asp
'## -------------------------------------------------------------------
'## Feature     :   AspBox Base64 Encryption
'## Version     :   v1.0
'## Author      :   Lajox(lajox@19www.com)
'## Update Date :   2012/01/13 09:32
'## Description :   AspBox Base64 Encryption Block
'######################################################################

Class Cls_AB_E_Base64
	Private sBASE_64_CHARACTERS

	Private Sub Class_Initialize()
		sBASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
		sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)
	End Sub

	Private Sub Class_Terminate():End Sub

	'@ ******************************************************************
	'@ 过程名:  AB.E.Base64.E(Str) {简写为： AB.E.Base64(Str) }
	'@ 返  回:  由Base64加密后的字符串
	'@ 作  用:  使用Base64加密算法加密处理字符串
	'==Param==============================================================
	'@ Str  : 待加密的字符串 # [String]
	'==DEMO==============================================================
	'@ AB.E.Base64.E("aspbox") => YXNwYm94
	'@ ******************************************************************

	Public Default Function E(Byval S)
		E = Base64Encode(s)
	End Function

	'@ ******************************************************************
	'@ 过程名:  AB.E.Base64.D(Str)
	'@ 返  回:  由Base64解密后的字符串
	'@ 作  用:  解密由Base64加密算法的字符串
	'==Param==============================================================
	'@ Str  : 待解密的字符串 # [String]
	'==DEMO==============================================================
	'@ AB.E.Base64.D(AB.E.Base64.E("aspbox")) '返回值: aspbox
	'@ ******************************************************************

	Public Function D(Byval S)
		D = Base64Decode(s)
	End Function

	'计算unicode字符串的Ansi编码的长度
	Private Function strUnicodeLen(Byval s)
		Dim temp,str,i,k,p:k=0:str="a"&s
		For i=1 to Len(str)
			p = Asc(Mid(str,i,1))
			If p<0 Then p=65536+temp
			If p>255 Then
				k=k+2
			Else
				k=k+1
			End if
		Next
		temp = k-1
		strUnicodeLen = temp
	End Function

	'将Unicode编码的字符串，转换成Ansi编码的字符串
	Private Function strUnicode2Ansi(Byval s)
		Dim temp,str,i,k:str=""&s
		Dim varHex,varLow,varHigh
		For i=1 To Len(str)
			k = Asc(Mid(str,i,1))
			If k<0 Then k=k+65536
			If k>255 Then
				varHex=Hex(k)
				varLow=Left(varHex,2)
				varHigh=Right(varHex,2)
				temp=temp & ChrB("&H" & varLow) & ChrB("&H" & varHigh)
			Else
				temp=temp & ChrB(k)
			End If
		Next
		strUnicode2Ansi = temp
	End function

	'将Ansi编码的字符串，转换成Unicode编码的字符串
	Private Function strAnsi2Unicode(Byval s)
		Dim temp,str,i,k,p:str=""&s
		If LenB(str)=0 Then Exit Function
		For i=1 To LenB(str)
			k = MidB(str,i,1)
			p=AscB(k)
			If p > 127 then
				temp = temp & Chr(Ascw(MidB(str,i+1,1) & k))
				i = i+1
			Else
				temp = temp & Chr(p)
			End if
		Next
		strAnsi2Unicode = temp
	End function

	Private Function Base64encodeANSI(asContents)
		'将Ansi编码的字符串进行Base64编码
		'asContents应当是ANSI编码的字符串（二进制的字符串也可以）
		Dim lnPosition,lsResult
		Dim Char1,Char2,Char3,Char4,Byte1,Byte2,Byte3,SaveBits1,SaveBits2
		Dim lsGroupBinary,lsGroup64,m3,m4,len1,len2
		len1=Lenb(asContents)
		if len1<1 then
		Base64encodeANSI=""
		exit Function
		end if
		m3=len1 Mod 3
		If m3 > 0 Then asContents = asContents & String(3-m3, chrb(0))
		IF m3 > 0 THEN
		len1=len1+(3-m3)
		len2=len1-3
		else
		len2=len1
		end if
		lsResult = ""
		For lnPosition = 1 To len2 Step 3
		lsGroup64 = ""
		lsGroupBinary = Midb(asContents, lnPosition, 3)
		Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
		Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
		Byte3 = Ascb(Midb(lsGroupBinary, 3, 1))
		Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
		Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
		Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
		Char4 = Midb(sBASE_64_CHARACTERS, (Byte3 And 63) + 1, 1)
		lsGroup64 = Char1 & Char2 & Char3 & Char4
		lsResult = lsResult & lsGroup64
		Next
		if m3 > 0 then
		lsGroup64 = ""
		lsGroupBinary = Midb(asContents, len2+1, 3)
		Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
		Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
		Byte3 = Ascb(Midb(lsGroupBinary, 3, 1))
		Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
		Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
		Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
		if m3=1 then
		lsGroup64 = Char1 & Char2 & ChrB(61) & ChrB(61)
		else
		lsGroup64 = Char1 & Char2 & Char3 & ChrB(61)
		end if
		lsResult = lsResult & lsGroup64
		end if
		Base64encodeANSI = lsResult
	End Function

	Private Function Base64decodeANSI(asContents)
		'将Base64编码字符串转换成Ansi编码的字符串
		'asContents应当也是ANSI编码的字符串（二进制的字符串也可以）
		Dim lsResult, lnPosition
		Dim Char1, Char2, Char3, Char4, Byte1, Byte2, Byte3
		Dim lsGroup64, lsGroupBinary, M4, len1, len2
		len1= Lenb(asContents)
		M4 = len1 Mod 4
		if len1 < 1 or M4 > 0 then
		Base64decodeANSI = ""
		exit Function
		end if
		if midb(asContents, len1, 1) = chrb(61) then m4=3
		if midb(asContents, len1-1, 1) = chrb(61) then m4=2
		if m4 = 0 then
		len2=len1
		else
		len2=len1-4
		end if
		For lnPosition = 1 To Len2 Step 4
		lsGroupBinary = ""
		lsGroup64 = Midb(asContents, lnPosition, 4)
		Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1
		Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1
		Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1
		Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1
		Byte1 = Chrb(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)
		Byte2 = lsGroupBinary & Chrb(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
		Byte3 = Chrb((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))
		lsGroupBinary = Byte1 & Byte2 & Byte3
		lsResult = lsResult & lsGroupBinary
		Next
		'处理最后剩余的几个字符
		if M4 > 0 then
		lsGroupBinary = ""
		lsGroup64 = Midb(asContents, len2+1, m4) & chrB(65) 'chr(65)=A，转换成值为0
		if M4=2 then '补足4位，是为了便于计算
		lsGroup64 = lsGroup64 & chrB(65)
		end if
		Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1
		Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1
		Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1
		Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1
		Byte1 = Chrb(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)
		Byte2 = lsGroupBinary & Chrb(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
		Byte3 = Chrb((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))
		if M4=2 then
		lsGroupBinary = Byte1
		elseif M4=3 then
		lsGroupBinary = Byte1 & Byte2
		end if
		lsResult = lsResult & lsGroupBinary
		end if
		Base64decodeANSI = lsResult
	End Function

	Private Function Base64Encode(tpStr)
		Base64Encode=strAnsi2Unicode(Base64encodeANSI(strUnicode2Ansi(tpStr)))
	End Function

	Private Function Base64Decode(tpStr)
		Base64Decode=strAnsi2Unicode(Base64decodeANSI(strUnicode2Ansi(tpStr)))
	End Function
End Class
%>